home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0110_Gif info display.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  4.4 KB  |  166 lines
  1. {
  2. BS> Can anone out there tell me where you get the resoloution out of a Gif file
  3. BS> from? What I am saying is, I would like to make a program to look at a Gif
  4. BS> and grab the resoloution out of it for my dir list files. Any help would be
  5. BS> appreciated.
  6.  
  7. I've written a freeware program to do just this.  Program name is GRR,
  8. and Pascal source accompanies it.  Here is the source from the latest
  9. (and only) version.  I apologize for the lack of comments, but it is
  10. rather straightforward, I think. }
  11.  
  12. program getGIFheader;
  13. uses
  14.   dos;
  15. const
  16.   progdata = 'GRR- Free DOS utility: GIF file info displayer.';
  17.   progdat2 =
  18.   'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  19.   usage =
  20.   'Usage:  GRR directory and/or file_spec[.GIF]   Example:  GRR cindyc*';
  21. var
  22.   header : string[6];
  23.   gpixn : byte;
  24.   gpixels, gback, rwidthLSB, rheightLSB, rwidth, rheight : char;
  25.   gifname : string[12];
  26.   giffile : text;
  27.   dirinfo : searchrec;
  28.   gpath : pathstr;
  29.   gdir : dirstr;
  30.   gname : namestr;
  31.   gext : extstr;
  32.  
  33. procedure showhelp;
  34. begin {-- showhelp --}
  35.   writeln(progdata);
  36.   writeln(progdat2);
  37.   writeln(usage);
  38.   halt;
  39. end {-- showhelp --};
  40.  
  41. function taffy(astring : string; newlen : byte) : string;
  42. begin {-- taffy --}
  43.   while (length(astring) < newlen) do
  44.     astring := astring + ' ';
  45.   taffy := astring;
  46. end {-- taffy --};
  47.  
  48. function LeadingZero(w : Word) : string;
  49. var
  50.   s : string;
  51. begin {-- LeadingZero --}
  52.   Str(w : 0, s);
  53.   if (length(s) = 1) then
  54.     s := '0' + s;
  55.   LeadingZero := s;
  56. end {-- LeadingZero --};
  57.  
  58. procedure writeftime(fdatetime : longint);
  59. var
  60.   Year2 : string;
  61.   DateTimeInf : DateTime;
  62. begin {-- writeftime --}
  63.   UnpackTime(fdatetime, DateTimeInf);
  64.   with DateTimeInf do
  65.   begin
  66.   Year2 := LeadingZero(Year);
  67.   Delete(Year2, 1, 2);
  68.   Write(LeadingZero(Month), '-', LeadingZero(Day), '-', Year2, '  ',
  69.   LeadingZero(Hour), ':', LeadingZero(Min), ':', LeadingZero(Sec));
  70.   end;
  71. end {-- writeftime --};
  72.  
  73.  
  74. procedure displaygifscreenstats(screendes : byte);
  75. var
  76.   GCM : Boolean;
  77. begin {-- displaygifscreenstats --}
  78.   GCM := screendes > 128;
  79.   if (screendes > 128) then
  80.     screendes := screendes - 128;
  81.   if (screendes > 64) then
  82.     screendes := screendes - 64;
  83.   if (screendes > 32) then
  84.     screendes := screendes - 32;
  85.   if (screendes > 16) then
  86.     screendes := screendes - 16;
  87.   if (screendes > 8) then
  88.     screendes := screendes - 8;
  89.   case (screendes) of
  90.     0: Write('  2');
  91.     1: Write('  4');
  92.     2: Write('  8');
  93.     3: Write(' 16');
  94.     4: Write(' 32');
  95.     5: Write(' 64');
  96.     6: Write('128');
  97.     7: Write('256');
  98.   end {-- CASE --};
  99.   if (GCM) then
  100.     Write(' ]  GCM/')
  101.   else
  102.     Write(' ]  ---/');
  103. end {-- displaygifscreenstats --};
  104.  
  105. procedure checkforgiflite(var thefile : text);
  106. var
  107.   ic : Word;
  108.   dummy, glite : char;
  109.   gliteword : string[7];
  110. begin {-- checkforgiflite --}
  111.   for ic := 13 to 784 do
  112.     read(thefile, dummy);
  113.   gliteword := '       ';
  114.   for ic := 1 to 7 do
  115.     begin
  116.     read(thefile, glite);
  117.     gliteword[ic] := glite;
  118.     end;
  119.   if (pos('GIFLITE', gliteword) = 1) then
  120.     Write('GL')
  121.   else
  122.     Write('--');
  123. end {-- checkforgiflite --};
  124.  
  125. begin {-- getGIFheader --}
  126.   gpath := '';
  127.   gpath := paramstr(1);
  128.   if (gpath = '') then
  129.     gpath := '*.gif';
  130.   if (pos('.', gpath) <> 0) then
  131.     begin
  132.     gpath := copy(gpath, 1, pos('.', gpath));
  133.     gpath := gpath + 'gif'
  134.     end
  135.   else
  136.     gpath := gpath + '*.gif';
  137.   fsplit(fexpand(gpath), gdir, gname, gext);
  138.   findfirst(gpath, archive, dirinfo);
  139.   if (doserror <> 0) then
  140.     showhelp;
  141.   while (doserror = 0) do
  142.     begin
  143.     gifname := dirinfo.name;
  144.     assign(giffile, gdir + gifname);
  145.     reset(giffile);
  146.     read(giffile, header);
  147.     if (pos('GIF', header) <> 1) then
  148.       header := '?_GIF?';
  149.     read(giffile, rwidthLSB, rwidth, rheightLSB, rheight, gpixels, gback);
  150.     gifname := taffy(gifname, 12);
  151.     Write(gifname, '  ', dirinfo.size:7, '  ');
  152.     writeftime(dirinfo.time);
  153.     Write('    ', header, '   [');
  154.     Write((ord(rwidthLSB) + (256 * ord(rwidth))):4, ' ',
  155.          (ord(rheightLSB) + (256 * ord(rheight))):4, '  ');
  156.     gpixn := ord(gpixels);
  157.     displaygifscreenstats(gpixn);
  158.     {         write ( ', ', ord ( gback )); }
  159.     { This is the background color, commented out since it is not used }
  160.     checkforgiflite(giffile);
  161.     writeln;
  162.     close(giffile);
  163.     findnext(dirinfo);
  164.     end;
  165. end {-- getGIFheader --}.
  166.